home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE07 / YAST / EXTRACE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-01-04  |  1.3 KB  |  67 lines
  1. unit ExTrace;
  2.  
  3. interface
  4.  
  5. uses
  6.   YAST;
  7.  
  8. function ExampleReportStackFrame(var StackInfo: TStackInfo; PrivateData: Pointer): boolean;
  9.  
  10. implementation
  11.  
  12. {$IFDEF WINDOWS}
  13. uses
  14.   WinCrt;
  15. {$ENDIF}
  16.  
  17. type
  18.   str2    = string[2];
  19.   str4    = string[4];
  20.   WordRec = record
  21.     Lo, Hi : byte;
  22.   end;
  23.  
  24. function HexB(Byt: byte): Str2;
  25. const
  26.   HexChars : array[0..15] of char = '0123456789ABCDEF';
  27. begin
  28.   HexB := HexChars[Byt shr 4] + HexChars[Byt and $0F];
  29. end;
  30.  
  31.  
  32. function HexW(Wrd: Word): Str4;
  33. begin
  34.   HexW := HexB(WordRec(Wrd).Hi) + HexB(WordRec(Wrd).Lo);
  35. end;
  36.  
  37.  
  38. function ExampleReportStackFrame(var StackInfo: TStackInfo; PrivateData: Pointer): boolean;
  39. const
  40.   Dists : array[boolean] of char = ('N', 'F');
  41. type
  42.   PBoolean = ^Boolean;
  43. var
  44.   i     : integer;
  45.   FirstFlag : PBoolean absolute PrivateData;
  46. begin
  47.   if FirstFlag^ then
  48.   begin
  49.     FirstFlag^ := false;
  50.     Writeln('Starting stack trace:');
  51.     Writeln('CS=', HexW(CSeg));
  52.     Writeln('DS=', HexW(DSeg));
  53.     Writeln('SS=', HexW(SSeg));
  54.   end;
  55.  
  56.   with StackInfo do
  57.   begin
  58.     Write(Dists[IsFar], ' ', HexW(ReturnLog), ':', HexW(ReturnOfs), ' = ');
  59.     for i := 0 to ParamSize-1 do
  60.       Write(HexW(ParamPtr^[i]), ',');
  61.     Writeln;
  62.   end;
  63.   ExampleReportStackFrame := true;
  64. end;
  65.  
  66. end.
  67.